home *** CD-ROM | disk | FTP | other *** search
/ Merciful 5 / Merciful - Disc 5.iso / software / p / pcqpascalv1.2d.lha / Examples2 / Stars / Stars.p < prev   
Encoding:
Text File  |  1997-05-06  |  5.9 KB  |  196 lines
  1.  
  2. { -----------------------------------------------------------------------
  3.   -  Sternensimulation im Vorbeiflug, oder ?                            -
  4.   -----------------------------------------------------------------------
  5. }
  6.  
  7. Program Stars;
  8.  
  9. {$I "include:Exec/libraries.i"  }
  10. {$I "include:Intuition/screens.i"  }
  11. {$I "include:intuition/intuition.i"}
  12. {$I "include:graphics/Pens.i"      } { für die WritePixel-Funktion }
  13. {$I "include:graphics/Graphics.i"  } { für die GFXBase }
  14. {$I "include:graphics/rastport.i"  } { für den Rastport }
  15. {$I "include:Utils/stringlib.i"    }
  16. {$I "Include:Utils/CRT.i"}
  17. {$I "Include:Utils/random.i"}        { Zufall }
  18. {$I "dh0:pcq/module/game.i"}         { Die Spiel-Routinen }
  19.  
  20.  
  21.  
  22.  
  23. CONST
  24.  
  25.         { Wir definieren einen Screen mit 3-Bitlanes und keiner Titel-
  26.           leiste. Hires und 640 x 200 Punkte Auflösung }
  27.  
  28.         NewScr : NewScreen  =  ( 0, 0, 640, 200, 3, 1, 0, HIRES,
  29.                                  CUSTOMSCREEN_f + SCREENQUIET_f,
  30.                                  NIL, NIL, NIL, NIL);
  31.  
  32.         { Und jetzt ein Rahmenloses Fenster }
  33.  
  34.         NewWin : NewWindow  =  (0,0,640,200,0,0,0,
  35.                                 BORDERLESS + ACTIVATE,
  36.                                 NIL,NIL,"",
  37.                                 NIL,NIL,0,0,0,0,
  38.                                 CUSTOMSCREEN_F);
  39.  
  40.  
  41.         { Wir definieren eine Farbtabelle mit 8 Farben für LoadRGB4 }
  42.  
  43.         Farbtabelle : array[1..8] of short = (
  44.  
  45.                         $0002,   { Schwarz }
  46.                         $0FFF,   { Weiß }
  47.                         $000A,   { Blau }
  48.                         $0F0F,   { Pink }
  49.                         $00FF,   { Türkis }
  50.                         $00F0,   { Grün }
  51.                         $092F,   { Violett }
  52.                         $0A00    { Rot}
  53.  
  54.                         );
  55.  
  56. VAR
  57.         MyVPort         : Address;
  58.         Scr             : ScreenPtr;
  59.         Win             : WindowPtr;
  60.  
  61. PROCEDURE cleanexit(why : String ; rtcode : Integer);
  62.  
  63. BEGIN
  64.         IF Win      <> NIL THEN CloseWindow(Win);
  65.         IF Scr      <> NIL THEN CloseScreen(Scr);
  66.         IF GfxBase  <> NIL THEN CloseLibrary(GfxBase);
  67.  
  68.                 { ## Ausgabe ins CLI, warum das Program verlassen }
  69.                 { ## werden mußte, inkl.Returncode f. Batchfiles  }
  70.         IF why<>NIL THEN writeln(why);
  71.         exit(rtcode);
  72. END;
  73.  
  74. Procedure InitScreen();
  75. { Initialisiert die Bildschirmdaten }
  76. begin
  77.   Scr:=OpenScreen(Adr(NewScr));
  78.   IF Scr = NIL THEN cleanexit("Can`t open Screen.",5);
  79.  
  80.   NewWin.Screen:=Scr;
  81.   Win:=OpenWindow(Adr(NewWin));
  82.   IF Win=NIL THEN cleanexit("Can`t open window.",5);
  83.  
  84.   MyVPort:=Adr(Scr^.SViewPort);
  85.   MyRPort:=Win^.RPort;
  86.   MyBitMap := MyRPort^.BitMap;
  87.   LoadRGB4(MyVPort,ADR(Farbtabelle),8);
  88.  
  89. end; { InitScreen }
  90.  
  91. Procedure InitAnything();
  92. { Initialisiert die sonstigen Daten }
  93. var
  94.     tt1 : short;
  95. begin
  96.   SelfSeed();
  97.   GfxBase:=OpenLibrary("graphics.library",0);
  98.   IF GfxBase=NIL THEN cleanexit("Can`t open Gfx.lib.",20);
  99.  
  100.     for tt1 := 0 to 255  do      { Die nicht benutzten Objekte kennzeichnen }
  101.         Objekt[tt1].Ox := -1;
  102.  
  103. end; { InitAnything }
  104.  
  105. procedure Farbe(tt1,tt2,tt3 : byte); { tt1=Schriftart,tt2=Vordergrundfarbe,
  106.                                        tt3 = Hintergrundfarbe }
  107. var
  108.     tt4, dummy : integer;
  109. begin
  110.     SetDrMd(MyRPort,JAM2);
  111.     SetAPen(MyRPort,tt2);
  112.     SetBPen(MyRPort,tt3);
  113.     if tt1 = 0 then tt4 := 0;
  114.     if tt1 = 1 then tt4 := 2;
  115.     if tt1 = 3 then tt4 := 4;
  116.     if tt1 = 4 then tt4 := 1;
  117.     dummy := SetSoftStyle(MyRPort,tt4,$ff);
  118. end; { Farbe}
  119.  
  120. Procedure SetStars();
  121. { Setzt die Sterne auf die Ausgangsposition. Die Sterne belegen die
  122.   Objektnummern 201 - 212 }
  123. var
  124.     tt  : byte;
  125. begin
  126.     for tt := 201 to 203 do begin
  127.         Objekt[tt].Ox := RangeRandom(640); { x - Koordinate }
  128.         Objekt[tt].Oy := RangeRandom(200); { y - Koordinate }
  129.         Objekt[tt].Speedx := -1; { x - Geschwindigkeit }
  130.         Objekt[tt].Speedy := 0; { y - Geschwindigkeit }
  131.         Objekt[tt].typ := 10; { Es ist nur ein Punkt }
  132.     end;
  133.     for tt := 204 to 206 do begin
  134.         Objekt[tt].Ox := RangeRandom(640); { x - Koordinate }
  135.         Objekt[tt].Oy := RangeRandom(200); { y - Koordinate }
  136.         Objekt[tt].Speedx := -2; { x - Geschwindigkeit }
  137.         Objekt[tt].Speedy := 0; { y - Geschwindigkeit }
  138.         Objekt[tt].typ := 10; { Es ist nur ein Punkt }
  139.     end;
  140.     for tt := 207 to 209 do begin
  141.         Objekt[tt].Ox := RangeRandom(640); { x - Koordinate }
  142.         Objekt[tt].Oy := RangeRandom(200); { y - Koordinate }
  143.         Objekt[tt].Speedx := -4; { x - Geschwindigkeit }
  144.         Objekt[tt].Speedy := 0; { y - Geschwindigkeit }
  145.         Objekt[tt].typ := 10; { Es ist nur ein Punkt }
  146.     end;
  147.     for tt := 210 to 212 do begin
  148.         Objekt[tt].Ox := RangeRandom(640); { x - Koordinate }
  149.         Objekt[tt].Oy := RangeRandom(200); { y - Koordinate }
  150.         Objekt[tt].Speedx := -8; { x - Geschwindigkeit }
  151.         Objekt[tt].Speedy := 0; { y - Geschwindigkeit }
  152.         Objekt[tt].typ := 10; { Es ist nur ein Punkt }
  153.     end;
  154.  
  155. end; { SetStars }
  156.  
  157.  
  158. Procedure MoveStars();
  159. { Bewegt die Sterne }
  160. var
  161.     tt : byte;
  162. begin
  163.     for tt := 201 to 212 do begin
  164.         Farbe(0,0,0);   { Hintergrundfarbe setzen }
  165.         WritePixel(MyRPort,Objekt[tt].Ox,Objekt[tt].Oy); { Stern löschen }
  166.         Farbe(0,1,0);   { Farbe auf Weiß setzen }
  167.         Objekt[tt].Ox := Objekt[tt].Ox + Objekt[tt].Speedx; { Stern verschieben }
  168.         if Objekt[tt].Ox < 0 then begin
  169.             Objekt[tt].Ox := 640;  { Wenn kleiner 0 dann wieder am Ausgangspunkt}
  170.             Objekt[tt].Oy := RangeRandom(200); { neue y - Koordinate }
  171.         end; { if }
  172.         WritePixel(MyRPort,Objekt[tt].Ox,Objekt[tt].Oy); { Stern zeichnen }
  173.     end; {for}
  174. end; { Movestars }
  175.  
  176. var
  177.     ii, jj : integer;
  178.     Maske1, Maske2  : byte;
  179.  
  180. BEGIN
  181.  
  182.     InitAnything(); { sonstiges Initialisieren }
  183.     InitScreen();   { Und jetzt den Screen }
  184.  
  185.     SetStars();
  186.  
  187.     repeat
  188.  
  189.         MoveStars();
  190.  
  191.     until GetChar() = 51;
  192.  
  193.   cleanexit(NIL,0);                     { bye bye baby .... }
  194.  
  195. END.
  196.